home *** CD-ROM | disk | FTP | other *** search
/ HPAVC / HPAVC CD-ROM.iso / SKY.ZIP / TESTSKY.PAS < prev   
Pascal/Delphi Source File  |  1996-02-14  |  4KB  |  125 lines
  1. {*****************************************************************************}
  2. {*                                                                           *}
  3. {*                                 SKY                                       *}
  4. {*                                                                           *}
  5. {* This code is Copyright (C) 1996 Mark Mackey. Use, modification,           *}
  6. {* and redistribution of this code is freely permitted, provided that        *}
  7. {* the original author is acknowledged.                                      *}
  8. {*                                                                           *}
  9. {*****************************************************************************}
  10.  
  11. program showsky;
  12. uses crt;
  13. type maptype=array[0..65534] of byte;
  14.      mapptr=^maptype;
  15. const screen:pointer=pointer($A0000000);
  16. var sky,buffer:mapptr;
  17.     i:longint;
  18.     randseed:longint;
  19.  
  20. {$L testsky.obj}
  21. procedure projectsky(sky:mapptr;buffer:pointer;x,y,height:longint);external;
  22. {Projects the sky to the buffer. x, y and height are all in 16.16
  23.  fixed point format. Assumes a buffer width of 256.
  24.  See TESTSKY.ASM for details.}
  25.  
  26. {$L subdiv.obj}
  27. procedure subdivide(map:mapptr;start,side:word);external;
  28. {Creates a wraparound fractal map using recursive subdivision.
  29.  Assumes that the map is 256x256 bytes, initialised to all 255's
  30.  except for some seed values at the corners.
  31.  See SUBDIV.ASM for more details.}
  32.  
  33. procedure smooth(map:mapptr;shift:word);external;
  34. {Smooths a map and adds _shift_ to all values}
  35.  
  36. procedure SetPalette;
  37. { Sets the palette. This is fairly crude: much better palettes can
  38.   be designed using a decent palette editor. Colour 129 is the
  39.   background sky colour: higher values are increasing cloudiness.}
  40. var i:integer;j:byte;
  41. begin
  42.   port[$03c8]:=0;
  43.   for i:=1 to 3 do port[$03c9]:=0;
  44.   for i:=1 to 127 do
  45.   begin
  46.     port[$03c9]:=0;
  47.     port[$03c9]:=0; {*}
  48.     port[$03c9]:=0;
  49.   end;
  50.   for i:=0 to 95 do
  51.   begin
  52.     j:=byte(round(10+i/94*22));
  53.     port[$03c9]:=j;
  54.     j:=byte(round(10+(i+0.5)/94*22));
  55.     port[$03c9]:=j;
  56.     port[$03c9]:=32
  57.   end;
  58.   for i:=0 to 31 do
  59.   begin
  60.     j:=byte(round(32-i/61*10));
  61.     port[$03c9]:=j;
  62.     j:=byte(round(32-(i+0.33)/61*10));
  63.     port[$03c9]:=j;
  64.     j:=byte(round(32-(i+0.66)/61*10));
  65.     port[$03c9]:=j;
  66.   end;
  67. end;
  68.  
  69.  
  70. procedure MakeSky(sky:mapptr);
  71. { Makes the sky map. The sky only uses colours 129 to 255 }
  72. var i,j:longint;
  73. begin
  74.   for i:=0 to 65535 do sky^[i]:=$FF;    {Initialise map}
  75.   for i:=0 to 3 do
  76.   for j:=0 to 3 do
  77.   sky^[i*$4000+j*$40]:=$80;        {Set some initial values}
  78.   subdivide(sky,0,256);                 {and subdivide recursively}
  79.   smooth(sky,20);                       {Smooth off and add 20 to all values}
  80.   for i:=0 to 65535 do
  81.     if sky^[i]<129 then sky^[i]:=129;   {Limit to 129..255}
  82. end;
  83.  
  84. procedure blit(buffer:pointer;Lines:word);assembler;
  85. {Blit the buffer to the screen. Assumes a buffer width of 256, and
  86.  writes Lines lines from the buffer.}
  87. asm
  88.    push ds
  89.    lds  si,[buffer]
  90.    mov  ax,$A000
  91.    mov  es,ax
  92.    mov  di,32
  93.    mov  bx,[Lines]
  94. @Loop:
  95.    mov  cx,256
  96.    rep  movsb
  97.    add  di,64
  98.    dec  bx
  99.    jnz @Loop
  100.    pop  ds
  101. end;
  102.  
  103.  
  104. begin
  105.   randseed:=2;        {Change or use randomize to get a different sky}
  106.   getmem(buffer,65535);
  107.   getmem(sky,65535);
  108.   writeln('Generating map...');
  109.   MakeSky(sky);         {Make the sky map.}
  110.   asm
  111.     mov  ax,013h
  112.     int  10h        {Enter 320x200 256-colour graphics mode}
  113.   end;
  114.   SetPalette;        {Set up the palette}
  115.   i:=-1500;
  116.   repeat        {draw the sky, moving forwards and up}
  117.     inc(i);
  118.     projectsky(sky,buffer,0,i shl 14,400 shl 16 - i shl 14);
  119.     blit(buffer,96);
  120.   until (i>1550) or keypressed;
  121.   asm
  122.     mov  ax,03h;    {back to text mode}
  123.     int 10h
  124.   end;
  125. end.